perm filename MATCH.LSP[BNF,JRA] blob sn#030169 filedate 1973-03-21 generic text, type T, neo UTF8
00100	
00200	
00300	(DEFPROP <F1> 
00400	 (LAMBDA NIL
00500	  (LRR (QUOTE F1)
00600	       (FUNCTION (LAMBDA NIL (COND ((AND (<M2>)) (STK 0)) (*NIL*))))
00700	       (FUNCTION
00800		(LAMBDA (<*>) (COND ((AND (CH ∨) (<M2>)) (CONS (QUOTE OR) (CONS <*> (CONS (STK 0) NIL)))) (*NIL*)))))) 
00900	EXPR)
01000	
01100	(DEFPROP <M2> 
01200	 (LAMBDA NIL
01300	  (LRR (QUOTE M2)
01400	       (FUNCTION (LAMBDA NIL (COND ((AND (<M3>)) (STK 0)) (*NIL*))))
01500	       (FUNCTION
01600		(LAMBDA (<*>) (COND ((AND (CH ∧) (<M3>)) (CONS (QUOTE AND) (CONS <*> (CONS (STK 0) NIL)))) (*NIL*)))))) 
01700	EXPR)
01800	
01900	(DEFPROP <M3> 
02000	 (LAMBDA NIL
02100	  (NLRR (QUOTE M3)
02200		(FUNCTION
02300		 (LAMBDA NIL
02400		  (COND ((AND (CH /() (<F1>) (CH /))) (STK 1))
02500			((AND (CH ¬) (<M3>)) (CONS (QUOTE NOT) (CONS (STK 0) NIL)))
02600			((AND (<MPRM>)) (STK 0))
02700			(*NIL*)))))) 
02800	EXPR)
02900	
03000	(DEFPROP <MPRM> 
03100	 (LAMBDA NIL
03200	  (NLRR (QUOTE MPRM)
03300		(FUNCTION
03400		 (LAMBDA NIL
03500		  (COND ((AND (<ARG>) (<MOP>) (<ARG1>)) (CONS (STK 1) (CONS (STK 2) (CONS (STK 0) NIL))))
03600			((AND (SPWD OCR) (CH /[) (<PAT>) (CH /])) (STK 1))
03700			((AND (SPWD TREE) (CH /[) (<CNAME>) (CH /]))
03800			 (CONS (QUOTE MATCHER) (CONS (STK 1) (CONS (CONS (QUOTE TREE) (CONS (QUOTE C) NIL)) NIL))))
03900			(*NIL*)))))) 
04000	EXPR)
04100	
04200	(DEFPROP <MOP> 
04300	 (LAMBDA NIL
04400	  (NLRR (QUOTE MOP)
04500		(FUNCTION
04600		 (LAMBDA NIL
04700		  (COND ((AND (CH =)) (QUOTE EQ))
04800			((AND (CH <)) (QUOTE LESSP))
04900			((AND (CH >)) (QUOTE GREATERP))
05000			(*NIL*)))))) 
05100	EXPR)
05200	
05300	(DEFPROP <ARG1> 
05400	 (LAMBDA NIL (NLRR (QUOTE ARG1) (FUNCTION (LAMBDA NIL (COND ((AND (<ARG>)) (STK 0)) (*NIL*)))))) 
05500	EXPR)
05600	
05700	(DEFPROP <ARG> 
05800	 (LAMBDA NIL
05900	  (NLRR (QUOTE ARG)
06000		(FUNCTION
06100		 (LAMBDA NIL
06200		  (COND ((AND (SPWD LENGTH)) (CONS (QUOTE LENGTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL)))
06300			((AND (SPWD DEPTH)) (CONS (QUOTE DEPTH) (CONS (CONS (QUOTE CDR) (CONS (QUOTE C) NIL)) NIL)))
06400			((AND (<NUMBER>)) (STK 0))
06500			(*NIL*)))))) 
06600	EXPR)
06700	
06800	(DEFPROP <CNAME> 
06900	 (LAMBDA NIL
07000	  (NLRR (QUOTE CNAME)
07100		(FUNCTION
07200		 (LAMBDA NIL
07300		  (COND ((AND (<NUMBER>)) (CONS (QUOTE *CLM) (CONS (CONS (STK 0) NIL) NIL)))
07400			((AND (<ID>) (CH /[) (<VARLIST>) (CH /]))
07500			 (CONS (QUOTE *CLM) (CONS (CONS (CONS (STK 3) (STK 1)) NIL) NIL)))
07600			((AND (<ID>)) (CONS (QUOTE *CLM) (CONS (CONS (STK 0) NIL) NIL)))
07700			(*NIL*)))))) 
07800	EXPR)
07900	
08000	(DEFPROP <PAT> 
08100	 (LAMBDA NIL
08200	  (NLRR (QUOTE PAT)
08300		(FUNCTION
08400		 (LAMBDA NIL
08500		  (COND ((AND (<NOT1>) (<PRED>))
08600			 (CONS (QUOTE OCNP) (CONS (CONS (QUOTE VARIT) (CONS (STK 0) NIL)) (CONS (QUOTE C) NIL))))
08700			((AND (<PRED>))
08800			 (CONS (QUOTE OCPP) (CONS (CONS (QUOTE VARIT) (CONS (STK 0) NIL)) (CONS (QUOTE C) NIL))))
08900			((AND (<TM>))
09000			 (CONS (QUOTE OCTM) (CONS (CONS (QUOTE VARIT) (CONS (STK 0) NIL)) (CONS (QUOTE C) NIL))))
09100			((AND (<FNLET>))
09200			 (CONS (QUOTE OCFNL) (CONS (CONS (QUOTE QUOTE) (CONS (STK 0) NIL)) (CONS (QUOTE C) NIL))))
09300			(*NIL*)))))) 
09400	EXPR)
09500	
09600	(DEFPROP >F1< 
09700	 (LAMBDA(%N)
09800	  (OUTRUL %N
09900		  (FUNCTION
10000		   (LAMBDA NIL
10100		    (COND ((AND (MATCH (QUOTE (OR * *))) (>F1< 1) (>M2< 0)) (LIST (STK1) (QUOTE (:CH ∨)) (STK0)))
10200			  ((>M2< 1) (STK1))))))) 
10300	EXPR)
10400	
10500	(DEFPROP >M2< 
10600	 (LAMBDA(%N)
10700	  (OUTRUL %N
10800		  (FUNCTION
10900		   (LAMBDA NIL
11000		    (COND ((AND (MATCH (QUOTE (AND * *))) (>M2< 1) (>M3< 0)) (LIST (STK1) (QUOTE (:CH ∧)) (STK0)))
11100			  ((>M3< 1) (STK1))))))) 
11200	EXPR)
11300	
11400	(DEFPROP >M3< 
11500	 (LAMBDA(%N)
11600	  (OUTRUL %N
11700		  (FUNCTION
11800		   (LAMBDA NIL
11900		    (COND ((AND (MATCH (QUOTE (NOT *))) (>M3< 0)) (LIST (QUOTE (:CH ¬)) (STK0)))
12000			  ((>MPRM< 1) (STK1))
12100			  ((>F1< 1) (LIST (QUOTE (:CH /()) (STK1) (QUOTE (:CH /)))))))))) 
12200	EXPR)
12300	
12400	(DEFPROP >MPRM< 
12500	 (LAMBDA(%N)
12600	  (OUTRUL %N
12700		  (FUNCTION
12800		   (LAMBDA NIL
12900		    (COND ((AND (MATCH (QUOTE (* * *))) (>MOP< 2) (>ARG< 1) (>ARG1< 0)) (LIST (STK1) (STK2) (STK0)))
13000			  ((>PAT< 1) (LIST (QUOTE OCR) (QUOTE (:CH /[)) (STK1) (QUOTE (:CH /]))))
13100			  ((AND (MATCH (QUOTE (MATCHER * (TREE C)))) (>CNAME< 0))
13200			   (LIST (QUOTE TREE) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))))))) 
13300	EXPR)
13400	
13500	(DEFPROP >MOP< 
13600	 (LAMBDA(%N)
13700	  (OUTRUL %N
13800		  (FUNCTION
13900		   (LAMBDA NIL
14000		    (COND ((EQ (QUOTE EQ) (STK1)) (QUOTE (:CH =)))
14100			  ((EQ (QUOTE LESSP) (STK1)) (QUOTE (:CH <)))
14200			  ((EQ (QUOTE GREATERP) (STK1)) (QUOTE (:CH >)))))))) 
14300	EXPR)
14400	
14500	(DEFPROP >ARG1< 
14600	 (LAMBDA (%N) (OUTRUL %N (FUNCTION (LAMBDA NIL (COND ((>ARG< 1) (STK1))))))) 
14700	EXPR)
14800	
14900	(DEFPROP >ARG< 
15000	 (LAMBDA(%N)
15100	  (OUTRUL %N
15200		  (FUNCTION
15300		   (LAMBDA NIL
15400		    (COND ((AND (MATCH (QUOTE (LENGTH (CDR C))))) (QUOTE LENGTH))
15500			  ((AND (MATCH (QUOTE (DEPTH (CDR C))))) (QUOTE DEPTH))
15600			  ((>NUMBER< 1) (STK1))))))) 
15700	EXPR)
15800	
15900	(DEFPROP >CNAME< 
16000	 (LAMBDA(%N)
16100	  (OUTRUL %N
16200		  (FUNCTION
16300		   (LAMBDA NIL
16400		    (COND ((AND (MATCH (QUOTE (*CLM ((* . *))))) (>ID< 1) (>VARLIST< 0))
16500			   (LIST (STK1) (QUOTE (:CH /[)) (STK0) (QUOTE (:CH /]))))
16600			  ((AND (MATCH (QUOTE (*CLM (*)))) (>NUMBER< 0)) (STK0))
16700			  ((AND (MATCH (QUOTE (*CLM (*)))) (>ID< 0)) (STK0))))))) 
16800	EXPR)
16900	
17000	(DEFPROP >PAT< 
17100	 (LAMBDA(%N)
17200	  (OUTRUL %N
17300		  (FUNCTION
17400		   (LAMBDA NIL
17500		    (COND ((AND (MATCH (QUOTE (OCNP (VARIT *) C))) (>PRED< 0))
17600			   (LIST  @(:CH /¬) (STK0)))
17700			  ((AND (MATCH (QUOTE (OCPP (VARIT *) C))) (>PRED< 0)) (STK0))
17800			  ((AND (MATCH (QUOTE (OCTM (VARIT *) C))) (>TM< 0)) (STK0))
17900			  ((AND (MATCH (QUOTE (OCFNL (QUOTE *) C))) (>FNLET< 0)) (STK0))))))) 
18000	EXPR)